home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / ffspas.zip / DCOLOR.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  4KB  |  96 lines
  1. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2. {                                 - COLOR -                                }
  3. {--------------------------------------------------------------------------}
  4. {                         Version 1.0    02/01/90                          }
  5. {--------------------------------------------------------------------------}
  6. {  This program demonstrates a mouse driven unit that returns selected     }
  7. {  foreground and background colors to the following variables:            }
  8. {                                                                          }
  9. {  forecolor : interger - foreground color                                 }
  10. {  backcolor : integer  - background color                                 }
  11. {                                                                          }
  12. {  The unit also returns the following:                                    }
  13. {  forecolorsel : string - foreground color in English as a string         }
  14. {  backcolorsel : string - background color in English as a string         }
  15. {                                                                          }
  16. {  The TPU source code as shareware is available from:                     }
  17. {                                                                          }
  18. {                        The Final Frontier BBS                            }
  19. {                        1200, 2400, 9600 Baud                             }
  20. {                            (518) 761-0869                                }
  21. {--------------------------------------------------------------------------}
  22. { Written By : William W. Miller, Jr.  Final Frontier Software             }
  23. {              524 Rock Avenue         All rights reserved                 }
  24. {              Chestertown, NY 12817                                       }
  25. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  26.  
  27. PROGRAM dcolor;
  28.  
  29. USES crt, fastttt5, strnttt5, keyttt5, winttt5,
  30.      miscttt5, color55, nestttt5;
  31.  
  32. VAR
  33. ch  : CHAR;
  34.  
  35. BEGIN
  36.     IF numon THEN set_num(FALSE);
  37.    offcursor;
  38.    clrscr;
  39.     color(forecolorsel, backcolorsel, forecolor, backcolor);
  40.    gotoxy(1, 5);
  41.    mkwin(10, 2, 70, 12, forecolor, backcolor, 1);
  42.    writebetween(11, 69, 2, forecolor, backcolor, ' NESTTTT5 Color Attributes ');
  43.    writeat(12, 3, forecolor, backcolor,
  44.    '                     The foreground attribute is: '
  45.    + '(' + int_to_str(forecolor) + ')');
  46.  
  47.    writeat(12, 4, forecolor, backcolor,
  48.    '                     The background attribute is: '
  49.    + '(' + int_to_str(backcolor) + ')');
  50.  
  51.    writeat(12, 5, nttt.boxfcol, backcolor,
  52.    '              The Border foreground attribute is: '
  53.    + '(' + int_to_str(nttt.boxfcol) + ')');
  54.  
  55.    writeat(12, 6, forecolor, nttt.boxbcol,
  56.    '              The Border background attribute is: '
  57.    + '(' + int_to_str(nttt.boxbcol) + ')');
  58.  
  59.    writeat(12, 7, nttt.capfcol, backcolor,
  60.    '    First Capital letter foreground attribute is: '
  61.    + '(' + int_to_str(nttt.capfcol) + ')');
  62.  
  63.    writeat(12, 8, nttt.norfcol, backcolor,
  64.    '      Normal menu topics foreground attribute is: '
  65.    + '(' + int_to_str(nttt.norfcol) + ')');
  66.  
  67.    writeat(12, 9, nttt.lofcol, backcolor,
  68.    ' Non-selected menu topic foreground attribute is: '
  69.    + '(' + int_to_str(nttt.lofcol) + ')');
  70.  
  71.    writeat(12, 10, nttt.hifcol, backcolor,
  72.    '     Selected menu topic foreground attribute is: '
  73.    + '(' + int_to_str(nttt.hifcol) + ')');
  74.  
  75.    writeat(12, 11, forecolor, nttt.hibcol,
  76.    '     Selected menu topic background attribute is: '
  77.    + '(' + int_to_str(nttt.hibcol) + ')');
  78.  
  79.     IF moused THEN writeAT(20, 25, white, black, 'Press a key, a mousekey, or move the mouse');
  80.     IF NOT moused THEN writeAT(34, 25, white, black, 'Press a key ...');
  81.     delay(500);
  82.     ch := getkey;
  83.     IF windowcounter = 1 THEN rmwin;
  84.     reset_startup_mode;
  85.     mkwin(1,1,80,8,white,blue,1);
  86.   writecenter(2, White, blue,'FFSPAS Color Unit');
  87.     writecenter(3, white, blue, '(c) Copyright 1990 Final Frontier Software');
  88.     writecenter(4, white, blue, 'William W. Miller, Jr.');
  89.     writecenter(5, white, blue, '524 Rock Avenue, Chestertown, New York 12817');
  90.     writecenter(6, white, blue, 'Telephone (518) 494-4097');
  91.     writecenter(7, white, blue, 'Please Register Your Procedures at the Final Frontier BBS (518) 761-0869');
  92.     gotoxy(1, 9);
  93.     oncursor;
  94.     beep;
  95. END.
  96.